Amiga Plus 2000 #4/Amiga Plus CD - 2000 - No. 4.iso/Tools/Grafik/Misc/ImageEnginer/ARexx/Batch/Shear.ieb

Text File | 1997-02-02 | 5.3 KB | 235 lines

/*
** $VER: Shear.ieb 1.31, IE Arexx script
** Image Engineer Batch Processing script
** Copyright © by Patrik M Nydensten
** 2/2 1997 Stockholm/Sweden
**
** Shear image.
*/

options results
signal on error

parse arg input command
input = upper(strip(input))
address 'IMAGEENGINEER'

select  /* Required batch script commands */
  when input = 'INFO' then    return get_info()
  when input = 'CONFIG' then  return get_config(command)
  when input = 'PROCESS' then return process_image(command)
  otherwise do
    'REQUEST' '"Failure in call to batch script!"' '" Quit "'
    return '<ERROR>'
  end
end

exit 0

/* Required "Get_info" procedure  ------------------------------------ */
/* S = SECONDARY, A = ALPHA, 1 = Single file, 2 = Multiple files       */

get_info:
  back = 'OK'
return back

/* Required "Get_config" procedure  ---------------------------------- */

get_config:
  parse arg '"'command'"'

  Xoff=100 ; Yoff=100

  if command ~= '' then parse var command Xoff Yoff '#'CropQ '#'CalcType

  'IE_TO_FRONT'

  form = 'FORM "Shear" "Ok|Cancel "',
  ' INTEGER,"X Amount",-4096,4096,'Xoff',SLIDER',
  ' INTEGER,"Y Amount",-4096,4096,'Yoff',SLIDER'

  if command = '' then do
    form = form||' CHECKBOX,"Crop image to original size?",0',
    ' CYCLE,"Type:","Best|Fast",0'

    form
    parse var result ok Xoff Yoff CropQ CalcType .
    if ok = 0 then return '<ERROR>'

    if CalcType=0 then CalcType='BEST'
    else CalcType = 'FAST'
  end
  else do
    form
    parse var result ok Xoff Yoff .
    if ok = 0 then return '<ERROR>'

    CropQ = 'none'
    CalcType = 'none'
  end

  back = Xoff Yoff '#'CropQ '#'CalcType
return back

/* Required "Process_image" procedure  ------------------------------- */

process_image:
  parse arg '"'src_image'"' '"'dst_image'"' '"'options'"'
  parse var options Xoff Yoff '#'CropQ '#'CalcType .

  'OPEN' '"'src_image'"' '24'
  if (RC ~= 0) then do
    'IE_TO_FRONT'
    'REQUEST' '"Failed to load image:' d2c(10)||src_image'"' '" OK "'
    return '<ERROR>'
  end
  else LoadImage = result

/* X shearing ------------------------------ */

  'PROJECT_INFO' LoadImage 'WIDTH'    /* Get width of image */
  IW = RESULT
  'PROJECT_INFO' LoadImage 'HEIGHT'    /* Get height of image */
  IH = RESULT

  if CropQ = 0 then do
    'RESIZE' LoadImage (IW+abs(Xoff)*2) IH 'CENTER'
    NewImage = Result
    'CLOSE' LoadImage
    LoadImage = NewImage
  end

  if Xoff ~= 0 then do
    'OPEN' '"IE:Alpha/Gradient.alpha"' '8BIT'
    GradientImage = Result

    'ROTATE' GradientImage 90 'FAST'
    RotatedImage = Result
    'CLOSE' GradientImage

    'SCALE' RotatedImage (IW+abs(Xoff)*2) IH 'BEST'
    XAlphaImage = Result
    'CLOSE' RotatedImage
  end

  do while (Xoff ~= 0)

    if Xoff > 0 then do
      if Xoff > 127 then do
        XD = 127 ; Xoff = Xoff - XD
      end
      else do
        XD = Xoff ; Xoff = Xoff - XD
      end
    end
    else do
      if Xoff < -127 then do
        XD = -127 ; Xoff = Xoff - XD
      end
      else do
        XD = Xoff ; Xoff = Xoff - XD
      end
    end

    'MARK' XAlphaImage 'ALPHA'
    'MARK' LoadImage 'PRIMARY'

    'DISPLACE' XD 0 CalcType
    NewImage = result
    'CLOSE' LoadImage
    LoadImage = NewImage

  end

  if XAlphaImage ~= 'XALPHAIMAGE' then 'CLOSE' XAlphaImage


/* Y shearing ------------------------------ */

  'PROJECT_INFO' LoadImage 'WIDTH'    /* Get width of image */
  IW = RESULT
  'PROJECT_INFO' LoadImage 'HEIGHT'    /* Get height of image */
  IH = RESULT

  if CropQ = 0 then do
    'RESIZE' LoadImage IW (IH+abs(Yoff)*2) 'CENTER'
    NewImage = Result
    'CLOSE' LoadImage
    LoadImage = NewImage
  end

  if Yoff ~= 0 then do
    'OPEN' '"IE:Alpha/Gradient.alpha"' '8BIT'
    GradientImage = Result

    'SCALE' GradientImage IW (IH+abs(Yoff)*2) 'BEST'
    YAlphaImage = Result
    'CLOSE' GradientImage
  end

  do while (Yoff ~= 0)

    if Yoff > 0 then do
      if Yoff > 127 then do
        YD = 127 ; Yoff = Yoff - YD
      end
      else do
        YD = Yoff ; Yoff = Yoff - YD
      end
    end
    else do
      if Yoff < -127 then do
        YD = -127 ; Yoff = Yoff - YD
      end
      else do
        YD = Yoff ; Yoff = Yoff - YD
      end
    end

    'MARK' YAlphaImage 'ALPHA'
    'MARK' LoadImage 'PRIMARY'

    'DISPLACE' 0 YD CalcType
    NewImage = result
    'CLOSE' LoadImage
    LoadImage = NewImage

  end

  if YAlphaImage ~= 'YALPHAIMAGE' then 'CLOSE' YAlphaImage

  OutputImage = LoadImage

  if getclip('cfg_save_frmt')='' then setclip('cfg_save_frmt','ILBM CmpByteRun1')
  'SAVE_DATA' OutputImage '"'dst_image'"' '"'getclip('cfg_save_frmt')'"'
  if (RC ~= 0) then do
    'IE_TO_FRONT'
    'REQUEST' '"Failed to save image:' d2c(10)||dst_image'"' '" OK "'
    return '<ERROR>'
  end
  'CLOSE' OutputImage

  back = 'OK'
return back

/* Internal procedures  ---------------------------------------------- */

/*******************************************************************/
/* This is where control goes when an error code is returned by IE */
/* It puts up a message saying what happened and on which line     */
/*******************************************************************/

error:
if RC=5 then do
    IE_TO_FRONT
    LAST_ERROR
    'REQUEST "'||RESULT||'"'
end
else do
    IE_TO_FRONT
    LAST_ERROR
    'REQUEST "Error detected!!!'||D2C(10)||'Image Engineer error message is as follows'||D2C(10)||result||D2C(10)||'Script failed on line '||SIGL||'"' 'Doh!'
end

return '<ERROR>'